home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 1
/
Cream of the Crop 1.iso
/
PROGRAM
/
WEDL203.ARJ
/
DEMOTPW.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-07-30
|
20KB
|
552 lines
{-----------------------------------------------------------------------------}
{ }
{ WEDL(tm) - Windows Enhanced Dialog Library }
{ Copyright (c) 1991-1992, Nemisoft, Inc. }
{ All Rights Reserved }
{ Module: DEMOTPW.PAS }
{ }
{-----------------------------------------------------------------------------}
program DemoTPW;
{$S-}
{$R-}
{$N+}
{$R DEMOTPW.RES}
uses WinTypes, WinProcs, WEDL;
{-----------------------------------------------------------------------------}
type
states_t = record
state_code : PStr;
zip_low : Integer;
zip_high : Integer;
end;
{-----------------------------------------------------------------------------}
const
ClassName = 'WEDLDemoTPW';
idm_Dialog1 = 90;
idm_Exit = 91;
idm_About = 92;
idd_SSN = 100;
idd_FirstName = 101;
idd_MidInit = 102;
idd_LastName = 103;
idd_Address = 104;
idd_City = 105;
idd_State = 106;
idd_ZipCode = 107;
idd_Phone = 108;
idd_HireDate = 109;
idd_Wage = 110;
idd_Insert = 111;
idh_SSN = 100;
idh_FirstName = 101;
idh_MidInit = 102;
idh_LastName = 103;
idh_Address = 104;
idh_City = 105;
idh_State = 106;
idh_ZipCode = 107;
idh_Phone = 108;
idh_HireDate = 109;
idh_Wage = 110;
BAD_STATE = 1;
BAD_ZIP = 2;
BAD_DATE = 3;
states : array[0..54] of states_t = (
( state_code: 'AK'; zip_low: 995; zip_high: 999 ),
( state_code: 'AL'; zip_low: 350; zip_high: 369 ),
( state_code: 'AR'; zip_low: 716; zip_high: 729 ),
( state_code: 'AZ'; zip_low: 850; zip_high: 865 ),
( state_code: 'CA'; zip_low: 900; zip_high: 961 ),
( state_code: 'CO'; zip_low: 800; zip_high: 816 ),
( state_code: 'CT'; zip_low: 60; zip_high: 69 ),
( state_code: 'DE'; zip_low: 197; zip_high: 199 ),
( state_code: 'FL'; zip_low: 320; zip_high: 349 ),
( state_code: 'GA'; zip_low: 300; zip_high: 319 ),
( state_code: 'HI'; zip_low: 967; zip_high: 968 ),
( state_code: 'IA'; zip_low: 500; zip_high: 528 ),
( state_code: 'ID'; zip_low: 832; zip_high: 847 ),
( state_code: 'IL'; zip_low: 600; zip_high: 629 ),
( state_code: 'IN'; zip_low: 460; zip_high: 479 ),
( state_code: 'KS'; zip_low: 641; zip_high: 679 ),
( state_code: 'KY'; zip_low: 400; zip_high: 427 ),
( state_code: 'LA'; zip_low: 700; zip_high: 714 ),
( state_code: 'MA'; zip_low: 10; zip_high: 27 ),
( state_code: 'MD'; zip_low: 206; zip_high: 219 ),
( state_code: 'ME'; zip_low: 39; zip_high: 49 ),
( state_code: 'MI'; zip_low: 480; zip_high: 499 ),
( state_code: 'MN'; zip_low: 550; zip_high: 567 ),
( state_code: 'MO'; zip_low: 630; zip_high: 658 ),
( state_code: 'MS'; zip_low: 386; zip_high: 397 ),
( state_code: 'MT'; zip_low: 590; zip_high: 599 ),
( state_code: 'NC'; zip_low: 270; zip_high: 289 ),
( state_code: 'ND'; zip_low: 580; zip_high: 588 ),
( state_code: 'NE'; zip_low: 680; zip_high: 693 ),
( state_code: 'NH'; zip_low: 30; zip_high: 38 ),
( state_code: 'NJ'; zip_low: 70; zip_high: 89 ),
( state_code: 'NM'; zip_low: 870; zip_high: 884 ),
( state_code: 'NV'; zip_low: 889; zip_high: 898 ),
( state_code: 'NY'; zip_low: 100; zip_high: 149 ),
( state_code: 'OH'; zip_low: 430; zip_high: 458 ),
( state_code: 'OK'; zip_low: 730; zip_high: 749 ),
( state_code: 'OR'; zip_low: 970; zip_high: 979 ),
( state_code: 'PA'; zip_low: 150; zip_high: 196 ),
( state_code: 'RI'; zip_low: 27; zip_high: 29 ),
( state_code: 'SC'; zip_low: 290; zip_high: 299 ),
( state_code: 'SD'; zip_low: 570; zip_high: 577 ),
( state_code: 'TN'; zip_low: 370; zip_high: 385 ),
( state_code: 'TX'; zip_low: 750; zip_high: 885 ),
( state_code: 'UT'; zip_low: 840; zip_high: 847 ),
( state_code: 'VA'; zip_low: 220; zip_high: 246 ),
( state_code: 'VT'; zip_low: 50; zip_high: 59 ),
( state_code: 'WA'; zip_low: 980; zip_high: 994 ),
( state_code: 'WI'; zip_low: 530; zip_high: 549 ),
( state_code: 'WV'; zip_low: 247; zip_high: 268 ),
( state_code: 'WY'; zip_low: 820; zip_high: 831 ),
( state_code: 'DC'; zip_low: 200; zip_high: 205 ),
( state_code: 'GU'; zip_low: 0; zip_high: 999 ),
( state_code: 'PR'; zip_low: 0; zip_high: 999 ),
( state_code: 'VI'; zip_low: 0; zip_high: 999 ),
( state_code: nil ; zip_low: 0; zip_high: 0 ) );
{-----------------------------------------------------------------------------}
var
Form : hform;
perror_func : PERRFUNC;
pcheck_state, pcheck_zip_code, pcheck_date : PVALFUNC;
tbuf : array[0..512] of Char;
soc_sec_no : LongInt;
first_name : array[0..15] of Char;
mid_init : array[0..1] of Char;
last_name : array[0..20] of Char;
address : array[0..30] of Char;
city : array[0..15] of Char;
state : array[0..2] of Char;
zip_code : array[0..9] of Char;
phone_num : array[0..10] of Char;
hire_date : array[0..8] of Char;
wage : Double;
wage_str : array[0..20] of Char;
{-----------------------------------------------------------------------------}
function AboutProc(Dialog: HWnd; Message, WParam: Word; LParam: Longint): Bool; export;
begin
AboutProc := True;
case Message of
wm_InitDialog:
Exit;
wm_Command:
if (WParam = id_Ok) or (WParam = id_Cancel) then
begin
EndDialog(Dialog, 1);
Exit;
end;
end;
AboutProc := False;
end;
{-----------------------------------------------------------------------------}
function ErrorHandler( Form: HFORM; Field: HFIELD; error_value, error_position,
error_event: Integer ): Bool; export;
var
Dialog: HWnd;
begin
ErrorHandler := True;
Dialog := form_get_hdlg( Form );
case error_value of
BAD_DATE:
begin
MessageBox( Dialog, 'Date Is Invalid', nil, mb_Ok );
Exit;
end;
BAD_STATE:
begin
MessageBox( Dialog, 'Invalid State Code', nil, mb_Ok );
Exit;
end;
BAD_ZIP:
begin
if (error_position > 1) then
MessageBox( Dialog, 'Zip Code is incomplete', nil, mb_Ok )
else
MessageBox( Dialog, 'Zip code is invalid for given State', nil, mb_Ok );
Exit;
end;
end;
ErrorHandler := False; { error was not handled }
end;
{-----------------------------------------------------------------------------}
function DialogProc(Dialog: HWnd; Message, WParam: Word; LParam: Longint): Bool; export;
var
P : array[0..11] of PChar;
begin
DialogProc := True;
case Message of
wm_InitDialog:
begin
Form := form_begin( Dialog, FMF_NOSELECT or FMF_VKEYPRES or
FMF_VLEAVFLD or FMF_UPDATE or FMF_OVERTYPE,
perror_func );
form_set_help( Form, 'demohelp.hlp', 0 );
field_define( Form, idd_SSN, @soc_sec_no, FDT_LONG,
'<0..7>99"-"99"-"9(4)', FDF_NOTBLANK or
FDF_BLNKZERO or FDF_ZEROFILL or FDF_COMPLETE or
FDF_NUMERIC, nil, 0, idh_SSN );
field_define( Form, idd_FirstName, @first_name, FDT_STRING,
'A(15)', FDF_PROPER, nil, 0, idh_FirstName );
field_define( Form, idd_MidInit, @mid_init, FDT_STRING,
'A(1)"."', FDF_UPPER, nil, 0, idh_MidInit );
field_define( Form, idd_LastName, @last_name, FDT_STRING,
'<A..Z>A(19)', FDF_PROPER,
nil, 0, idh_LastName );
field_define( Form, idd_Address, @address, FDT_STRING,
'?(30)', FDF_PROPER, nil, 0, idh_Address );
field_define( Form, idd_City, @city, FDT_STRING,
'?(15)', FDF_PROPER, nil, 0, idh_City );
field_define( Form, idd_State, @state, FDT_STRING,
'A(2)', FDF_COMPLETE or FDF_UPPER,
pcheck_state, BAD_STATE, idh_State );
field_define( Form, idd_ZipCode, @zip_code, FDT_STRING,
'<0..9>(5)"-"9(4)', FDF_NONE,
pcheck_zip_code, BAD_ZIP, idh_ZipCode );
field_define( Form, idd_Phone, @phone_num, FDT_STRING,
'"("999") "999"-"9999', FDF_COMPLETE,
nil, 0, idh_Phone );
field_define( Form, idd_HireDate, @hire_date, FDT_STRING,
' <01> 9 / <0123> 9 / <89> 9 ', FDF_COMPLETE or
FDF_PHYSICAL, pcheck_date, BAD_DATE,
idh_HireDate );
field_define( Form, idd_Wage, @wage, FDT_DOUBLE,
'999999.99', FDF_NUMERIC or FDF_BLNKZERO or
FDF_BLNKNEZ, nil, 0, idh_Wage );
keystat_define( Form, idd_Insert, KSM_INSERT, 'Insert: On',
'Insert: Off' );
form_end( Form );
Exit;
end;
wm_Command:
begin
if (WParam = id_Ok) then
begin
form_ok( Form );
EndDialog(Dialog, 1);
P[0] := PChar( soc_sec_no );
P[1] := first_name;
P[2] := mid_init;
P[3] := last_name;
P[4] := address;
P[5] := city;
P[6] := state;
P[7] := zip_code;
P[8] := phone_num;
P[9] := hire_date;
Str( wage, wage_str );
P[10] := wage_str;
wvsprintf( tbuf, 'Soc Sec No.' + Chr(9) + '= %09ld' + Chr(10) +
'Name' + Chr(9) + Chr(9) + '= %s %s. %s' + Chr(10) +
'Address' + Chr(9) + Chr(9) + '= %s' + Chr(10) +
Chr(9) + Chr(9) + '= %s, %s %s' + Chr(10) +
'Phone No.' + Chr(9) + '= %s' + Chr(10) +
'Hire Date' + Chr(9) + '= %s' + Chr(10) +
'Wage/Salary' + Chr(9) + '= %s', P );
MessageBox( 0, tbuf, 'Field Contents', mb_Ok );
Exit;
end;
if (WParam = id_Cancel) then
begin
form_cancel( Form );
EndDialog(Dialog, 1);
Exit;
end;
end;
wm_Close:
begin
SendMessage( Dialog, wm_Command, id_Cancel, 0 );
Exit;
end;
end;
DialogProc := False;
end;
{-----------------------------------------------------------------------------}
Function CheckDate( Form: HFORM; Field: HFIELD; PBuf: PStr ): Integer; export;
var
date : array[0..10] of Char;
month, day, year, Code: Integer;
begin
CheckDate := 0;
if not str_is_blank( PBuf ) then
begin
{ parse year, day, and month from buffer }
lstrcpy( date, PBuf );
Val( date + 4, year, Code );
date[4] := Chr( 0 );
Val( date + 2, day, Code );
date[2] := Chr( 0 );
Val( date, month, Code );
{ validate month }
if month > 12 then
begin
CheckDate := 1;
Exit;
end;
{ validate day and month }
if day < 1 then
begin
CheckDate := 3;
Exit;
end;
case month of
2:
if year mod 4 <> 0 then
begin
if day > 29 then
begin
CheckDate := 3;
Exit;
end;
end
else
begin
if day > 28 then
begin
CheckDate := 3;
Exit;
end;
end;
1, 3, 5, 7, 8, 10, 12:
if day > 31 then
begin
CheckDate := 3;
Exit;
end;
4, 6, 9, 11:
if day > 30 then
begin
CheckDate := 3;
Exit;
end;
else
begin
CheckDate := 1;
Exit;
end;
end;
end;
end;
{-----------------------------------------------------------------------------}
Function CheckState( Form: HFORM; Field: HFIELD; PBuf: PStr ): Integer; export;
var
i : Integer;
begin
{ allow state to be blank }
if str_is_blank( PBuf ) then
begin
CheckState := 0;
Exit;
end;
{ do for all state codes in the table }
i := 0;
while states[i].state_code <> nil do
begin
if lstrcmp( states[i].state_code, PBuf ) = 0 then
begin
CheckState := 0;
Exit;
end;
Inc( i );
end;
{ not a legal 2-letter state code }
CheckState := 1;
end;
{-----------------------------------------------------------------------------}
function CheckZipCode( Form: HFORM; Field: HFIELD; PBuf: PStr ): Integer; export;
var
p : PStr;
i, j, num_spaces : Integer;
zip, zip_low, zip_high : LongInt;
begin
{ allow zip code to be blank }
if str_is_blank( PBuf ) then
begin
CheckZipCode := 0;
Exit;
end;
{ count spaces in the extended portion of the 9-digit zip code }
num_spaces := 0;
p := PBuf + 5;
while p^ <> Chr( 0 ) do
begin
if p^ = ' ' then Inc( num_spaces );
Inc( p );
end;
{ if zip code isn't exactly 5 or 9 digits, then there's an error }
if ( num_spaces <> 0 ) and ( num_spaces <> 4 ) then
begin
CheckZipCode := 6;
Exit;
end;
PBuf[5] := Chr( 0 );
field_log_to_data( Field, PBuf, @zip, FDT_LONG );
{ find matching state }
Field := field_get_from_ctrl_id( Form, IDD_STATE );
field_get_text( Field, tbuf, False );
i := 0;
j := -1;
while states[i].state_code <> nil do
begin
if lstrcmp( tbuf, states[i].state_code ) = 0 then j := i;
Inc( i );
end;
if j <> -1 then i := j;
if states[i].state_code = nil then
begin
CheckZipCode := 0;
Exit;
end;
{ test zip code }
zip_low := LongInt( states[i].zip_low ) * LongInt( 100 );
zip_high := LongInt( states[i].zip_high ) * LongInt( 100 );
if ( zip >= zip_low ) and ( zip <= zip_high ) then
CheckZipCode := 0
else
CheckZipCode := 1;
end;
{-----------------------------------------------------------------------------}
function MainWndProc(Window: HWnd; Message, WParam: Word; LParam: Longint): Longint; export;
var
pDialogProc, pAboutProc: TFarProc;
begin
MainWndProc := 0;
case Message of
wm_Command:
case WParam of
idm_Dialog1:
begin
pDialogProc := MakeProcInstance(@DialogProc, HInstance);
pcheck_date := MakeProcInstance(@CheckDate, HInstance );
pcheck_state := MakeProcInstance(@CheckState, HInstance );
pcheck_zip_code := MakeProcInstance(@CheckZipCode, HInstance );
perror_func := MakeProcInstance(@ErrorHandler, HInstance);
DialogBox(HInstance, 'DIALOG_1', Window, pDialogProc);
FreeProcInstance(perror_func);
FreeProcInstance(pcheck_zip_code);
FreeProcInstance(pcheck_state);
FreeProcInstance(pcheck_date);
FreeProcInstance(pDialogProc);
Exit;
end;
idm_Exit:
begin
SendMessage(Window, wm_Close, 0, 0);
Exit;
end;
idm_About:
begin
pAboutProc := MakeProcInstance(@AboutProc, HInstance);
DialogBox(HInstance, 'AboutWEDL', Window, pAboutProc);
FreeProcInstance(pAboutProc);
Exit;
end;
end;
wm_Destroy:
begin
PostQuitMessage(0);
Exit;
end;
end;
MainWndProc := DefWindowProc(Window, Message, WParam, LParam);
end;
{-----------------------------------------------------------------------------}
procedure InitApplication;
const
WindowClass: TWndClass = (
style: 0;
lpfnWndProc: @MainWndProc;
cbClsExtra: 0;
cbWndExtra: 0;
hInstance: 0;
hIcon: 0;
hCursor: 0;
hbrBackground: 0;
lpszMenuName: 'MainMenu';
lpszClassName: ClassName
);
begin
WindowClass.hInstance := HInstance;
WindowClass.hIcon := LoadIcon(0, idi_Application);
WindowClass.hCursor := LoadCursor(0, idc_Arrow);
WindowClass.hbrBackground := GetStockObject(white_Brush);
if not RegisterClass(WindowClass) then Halt(1);
end;
{-----------------------------------------------------------------------------}
procedure InitInstance;
var
Window: HWnd;
begin
Window := CreateWindow( ClassName, 'WEDL Demonstration Program',
ws_OverlappedWindow, cw_UseDefault, cw_UseDefault,
cw_UseDefault, cw_UseDefault, 0, 0, HInstance,
nil );
if Window = 0 then Halt(1);
ShowWindow(Window, CmdShow);
UpdateWindow(Window);
end;
{-----------------------------------------------------------------------------}
procedure WinMain;
var
Message: TMsg;
begin
if HPrevInst = 0 then InitApplication;
InitInstance;
while GetMessage(Message, 0, 0, 0) do
begin
TranslateMessage(Message);
DispatchMessage(Message);
end;
Halt(Message.wParam);
end;
begin
WinMain;
end.